W raporcie badano problem malejącej długości śledzia. Wczytano, opisano i oczyszczono dane. Dokonano analizy danych i koorelacji atrybutów. Zauważono, że największy wpływ przy koorelacji na długość śledzia ma temperatura przy powierzchni wody. Podczas wykorzystania regresorów dla regresji liniowej również ajwiększy wpływ maiała temperatura wody, a dla algorytmu Random Forrest natężenie połowów w regionie. Dla regresji liniowej przewidywana długość śledzia wynosi od 22.75cm 32.33cm, a dla Random Forrest od 20.82cm do 28.41cm.
Do przygotowania raportu wykorzystano bilbioteki:
W Europie zauważono stopniowy spadek długości śledzia oceanicznego, dlatego zbadano warunki w jakich żyją oraz zmierzono ich długość. Obserwacje (50-100 trzyletnich śledzi), które odbywały się w połowach komercyjnych jednostek dotyczą ostatnich 60 lat.
Wczytano plik podany na platformie eKursy oraz wyświetlono pierwsze oraz ostatnie wiersze.
read.csv(file='sledzie.csv')->herring_clear
kable(head(herring_clear[,1:8]), format = "markdown", caption = "Herring - początek pobranego zbioru danych PART 1")
| X | length | cfin1 | cfin2 | chel1 | chel2 | lcop1 | lcop2 |
|---|---|---|---|---|---|---|---|
| 0 | 23.0 | 0.02778 | 0.27785 | 2.46875 | ? | 2.54787 | 26.35881 |
| 1 | 22.5 | 0.02778 | 0.27785 | 2.46875 | 21.43548 | 2.54787 | 26.35881 |
| 2 | 25.0 | 0.02778 | 0.27785 | 2.46875 | 21.43548 | 2.54787 | 26.35881 |
| 3 | 25.5 | 0.02778 | 0.27785 | 2.46875 | 21.43548 | 2.54787 | 26.35881 |
| 4 | 24.0 | 0.02778 | 0.27785 | 2.46875 | 21.43548 | 2.54787 | 26.35881 |
| 5 | 22.0 | 0.02778 | 0.27785 | 2.46875 | 21.43548 | 2.54787 | ? |
kable(head(herring_clear[,9:16]), format = "markdown", caption = "Herring - początek pobranego zbioru danych PART 2")
| fbar | recr | cumf | totaln | sst | sal | xmonth | nao |
|---|---|---|---|---|---|---|---|
| 0.356 | 482831 | 0.3059879 | 267380.8 | 14.3069330186 | 35.51234 | 7 | 2.8 |
| 0.356 | 482831 | 0.3059879 | 267380.8 | 14.3069330186 | 35.51234 | 7 | 2.8 |
| 0.356 | 482831 | 0.3059879 | 267380.8 | 14.3069330186 | 35.51234 | 7 | 2.8 |
| 0.356 | 482831 | 0.3059879 | 267380.8 | 14.3069330186 | 35.51234 | 7 | 2.8 |
| 0.356 | 482831 | 0.3059879 | 267380.8 | 14.3069330186 | 35.51234 | 7 | 2.8 |
| 0.356 | 482831 | 0.3059879 | 267380.8 | 14.3069330186 | 35.51234 | 7 | 2.8 |
kable(tail(herring_clear[,1:8]), format = "markdown", caption = "Herring - koniec pobranego zbioru danych PART 1")
| X | length | cfin1 | cfin2 | chel1 | chel2 | lcop1 | lcop2 | |
|---|---|---|---|---|---|---|---|---|
| 52577 | 52576 | 21.5 | 0 | 0.01 | 1.02143 | 26.00617 | 1.06429 | 34.1456 |
| 52578 | 52577 | 24.0 | 1.02508 | 3.66319 | 6.42127 | 25.51806 | 10.92857 | 37.39201 |
| 52579 | 52578 | 26.0 | 1.02508 | 3.66319 | 6.42127 | 25.51806 | 10.92857 | 37.39201 |
| 52580 | 52579 | 25.0 | 1.02508 | 3.66319 | 6.42127 | 25.51806 | 10.92857 | 37.39201 |
| 52581 | 52580 | 25.0 | 0.36032 | 5.36402 | 4.32674 | 27.16006 | 5.08099 | 36.6877 |
| 52582 | 52581 | 23.5 | 0.36032 | 5.36402 | 4.32674 | 27.16006 | ? | 36.6877 |
kable(tail(herring_clear[,9:16]), format = "markdown", caption = "Herring - koniec pobranego zbioru danych PART 2")
| fbar | recr | cumf | totaln | sst | sal | xmonth | nao | |
|---|---|---|---|---|---|---|---|---|
| 52577 | 0.100 | 1322000 | 0.0922202 | 648314.9 | 14.5555996798 | 35.53620 | 7 | 2.05 |
| 52578 | 0.485 | 724151 | 0.3838187 | 457143.9 | 13.7115996983 | 35.51169 | 11 | 2.05 |
| 52579 | 0.485 | 724151 | 0.3838187 | 457143.9 | 13.7115996983 | 35.51169 | 11 | 2.05 |
| 52580 | 0.485 | 724151 | 0.3838187 | 457143.9 | 13.7115996983 | 35.51169 | 11 | 2.05 |
| 52581 | 0.434 | 441827 | 0.3726272 | 191976.2 | 14.4795996814 | 35.50777 | 6 | -1.90 |
| 52582 | 0.434 | 441827 | 0.3726272 | 191976.2 | 14.4795996814 | 35.50777 | 6 | -1.90 |
Sprawdzono, w których kolumnach pojawiają się wartości ?. Jeżeli taka
wartość wystąpiła to była pobierana wartość z poprzedniego wiersza dla
danej kolumny i przypisywana do sprawdzanego. W przypadku pustych
wartości w pierwszym wierszu dane były pobierane z drugiego wiersza.
Dodatkowo sprawdzono typy danych dla kolumn. Kolumny, które były typem
character zamieniono na numeric. Dane są
podane chronologicznie według zapisanych obserwacji.
herring_clear->herring
herring[herring == '?'] <- NA
herring<-fill(herring,cfin1,cfin2,chel1, chel2, lcop1, lcop2, sst, .direction ="updown")
print(sapply(herring, class))
## X length cfin1 cfin2 chel1 chel2
## "integer" "numeric" "character" "character" "character" "character"
## lcop1 lcop2 fbar recr cumf totaln
## "character" "character" "numeric" "integer" "numeric" "numeric"
## sst sal xmonth nao
## "character" "numeric" "integer" "numeric"
herring[, 3:8] <- sapply(herring[, 3:8], as.numeric)
herring[, 13] <- sapply(herring[, 13], as.numeric)
print(sapply(herring, class))
## X length cfin1 cfin2 chel1 chel2 lcop1 lcop2
## "integer" "numeric" "numeric" "numeric" "numeric" "numeric" "numeric" "numeric"
## fbar recr cumf totaln sst sal xmonth nao
## "numeric" "integer" "numeric" "numeric" "numeric" "numeric" "integer" "numeric"
kable(head(herring[,1:8]), format = "markdown", digits = 2, caption = "Herring - początek sformatowanego zbioru danych PART 1")
| X | length | cfin1 | cfin2 | chel1 | chel2 | lcop1 | lcop2 |
|---|---|---|---|---|---|---|---|
| 0 | 23.0 | 0.03 | 0.28 | 2.47 | 21.44 | 2.55 | 26.36 |
| 1 | 22.5 | 0.03 | 0.28 | 2.47 | 21.44 | 2.55 | 26.36 |
| 2 | 25.0 | 0.03 | 0.28 | 2.47 | 21.44 | 2.55 | 26.36 |
| 3 | 25.5 | 0.03 | 0.28 | 2.47 | 21.44 | 2.55 | 26.36 |
| 4 | 24.0 | 0.03 | 0.28 | 2.47 | 21.44 | 2.55 | 26.36 |
| 5 | 22.0 | 0.03 | 0.28 | 2.47 | 21.44 | 2.55 | 26.36 |
kable(head(herring[,9:16]), format = "markdown", digits = 2, caption = "Herring - początek sformatowanego zbioru danych PART 2")
| fbar | recr | cumf | totaln | sst | sal | xmonth | nao |
|---|---|---|---|---|---|---|---|
| 0.36 | 482831 | 0.31 | 267380.8 | 14.31 | 35.51 | 7 | 2.8 |
| 0.36 | 482831 | 0.31 | 267380.8 | 14.31 | 35.51 | 7 | 2.8 |
| 0.36 | 482831 | 0.31 | 267380.8 | 14.31 | 35.51 | 7 | 2.8 |
| 0.36 | 482831 | 0.31 | 267380.8 | 14.31 | 35.51 | 7 | 2.8 |
| 0.36 | 482831 | 0.31 | 267380.8 | 14.31 | 35.51 | 7 | 2.8 |
| 0.36 | 482831 | 0.31 | 267380.8 | 14.31 | 35.51 | 7 | 2.8 |
Wszystkie wartości w zbiorze są numeric lub integer. Dotyczą one:
length: długość złowionego śledzia [cm];
cfin1: dostępnośś planktonu [zagęszczenie Calanus finmarchicus gat. 1];
cfin2: dostępność planktonu [zagęszczenie Calanus finmarchicus gat. 2];
chel1: dostępność planktonu [zagęszczenie Calanus helgolandicus gat. 1];
chel2: dostępność planktonu [zagęszczenie Calanus helgolandicus gat. 2];
lcop1: dostępność planktonu [zagęszczenie widłonogów gat. 1];
lcop2: dostępność planktonu [zagęszczenie widłonogów gat. 2];
fbar: natężenie połowów w regionie [ułamek pozostawionego narybku];
recr: roczny narybek [liczba śledzi];
cumf: łączne roczne natężenie połowów w regionie [ułamek pozostawionego narybku];
totaln: łączna liczba ryb złowionych w ramach połowu [liczba śledzi];
sst: temperatura przy powierzchni wody [°C];
sal: poziom zasolenia wody [Knudsen ppt];
xmonth: miesiąc połowu [numer miesiąca];
nao: oscylacja północnoatlantycka [mb].
Zbiór danych zawiera 52582 wierszy i 16 kolumn. Minimalna długość śledzia: 19. Maksymalna długość śledzia: 32.5. Występuje 0 różnych długości.
Poniżej zostało przedstawione podsumowanie dotyczące wszystkich atrybutów.
kable(summary(herring)[,1:5])
| X | length | cfin1 | cfin2 | chel1 | |
|---|---|---|---|---|---|
| Min. : 0 | Min. :19.0 | Min. : 0.0000 | Min. : 0.0000 | Min. : 0.000 | |
| 1st Qu.:13145 | 1st Qu.:24.0 | 1st Qu.: 0.0000 | 1st Qu.: 0.2778 | 1st Qu.: 2.469 | |
| Median :26291 | Median :25.5 | Median : 0.1111 | Median : 0.7012 | Median : 5.750 | |
| Mean :26291 | Mean :25.3 | Mean : 0.4457 | Mean : 2.0255 | Mean :10.003 | |
| 3rd Qu.:39436 | 3rd Qu.:26.5 | 3rd Qu.: 0.3333 | 3rd Qu.: 1.7936 | 3rd Qu.:11.500 | |
| Max. :52581 | Max. :32.5 | Max. :37.6667 | Max. :19.3958 | Max. :75.000 |
kable(summary(herring)[,6:11])
| chel2 | lcop1 | lcop2 | fbar | recr | cumf | |
|---|---|---|---|---|---|---|
| Min. : 5.238 | Min. : 0.3074 | Min. : 7.849 | Min. :0.0680 | Min. : 140515 | Min. :0.06833 | |
| 1st Qu.:13.427 | 1st Qu.: 2.5479 | 1st Qu.:17.808 | 1st Qu.:0.2270 | 1st Qu.: 360061 | 1st Qu.:0.14809 | |
| Median :21.435 | Median : 7.0000 | Median :24.859 | Median :0.3320 | Median : 421391 | Median :0.23191 | |
| Mean :21.215 | Mean : 12.8079 | Mean :28.419 | Mean :0.3304 | Mean : 520367 | Mean :0.22981 | |
| 3rd Qu.:27.193 | 3rd Qu.: 21.2315 | 3rd Qu.:37.232 | 3rd Qu.:0.4560 | 3rd Qu.: 724151 | 3rd Qu.:0.29803 | |
| Max. :57.706 | Max. :115.5833 | Max. :68.736 | Max. :0.8490 | Max. :1565890 | Max. :0.39801 |
Z wcześniej wspomnianych założeń, że badania są podane chronologicznie można zobaczyć jak na początku rosła długość śledzia, a później częściej malała. Można to zauważyć przy 16640-tej obserwacji.
p<-ggplot(herring, aes(x=X)) +
geom_smooth(aes(y = length,colour="lenght"), color = "#4477AA") +
ggtitle("Animacja długości śledzia") +
xlab("Numer obserwacji") +
ylab("Długość śledzia [cm]")
ggplotly(p)
max_length <- layer_data(p)
max_length <- max_length[(which.max(max_length$y)),1:2]
head(max_length)
## x y
## 26 16639.56 26.8132
Poniżej przedstawione histogramy przedstawiają liczbę złowionych śledzi o danej długości z podziałem na miesiące. Można zauważyć, że najwięcej zebrano w sierpniu. Ciekawym przypadkiem jest brak połowów Śledzi o długości ok. 24cm.
ggplot(herring, aes(x=length)) +
geom_histogram(bins=30)+ facet_wrap(xmonth ~ .) +
theme(panel.grid.major = element_line(colour = "blue")) +
scale_x_continuous(breaks = round(seq(min(herring$length), max(herring$length), by = 2),1)) +
ggtitle("Histogramy długości śledzia dla danego miesiąca") +
xlab("Długość śledzia [cm]") +
ylab("Liczba śledzi")
Poniższy wykres przedstawia linie trendu dostępności planktonów. Nawiększe zagęszczenie mają 2. gatunek widłogonów, a najmniejszy 1. gatunek Calanus finmarchicus.
ggplot(herring, aes(x=length)) +
geom_smooth(aes(y = cfin1,colour="cfin1", color = "#4477AA")) +
geom_smooth(aes(y = cfin2,colour="cfin2", color="#EE6677")) +
geom_smooth(aes(y = chel1,colour="chel1", color="#228833")) +
geom_smooth(aes(y = chel2,colour="chel2", color="#CCBB44")) +
geom_smooth(aes(y = lcop1,colour="lcop1", color="#66CCEE")) +
geom_smooth(aes(y = lcop2,colour="lcop2", color="#AA3377")) +
scale_colour_manual(name="legend", values=c("#4477AA", "#EE6677","#228833","#CCBB44","#66CCEE","#AA3377")) +
ylab(bquote("Plankton availability")) +
ggtitle("Linie trendu dostępności planktonów") +
xlab("Długość śledzia [cm]") +
ylab("Dostępnośc planktonu")
Sprawdzono korelacje między zmiennymi. Nie sprawdzana była koorelacja numeru obserwacji z innymi atrybutami. Długość śledzia ma najsilniejszy współczynnik (-0.5) korelacji z temperaturą przy powierzchni wody (sst). Największy współczynnik korelacji (0.9) występuje dla zagęszczenia planktonów: Calanus finmarchicus gat. 2 (chel2) i widłonogów gat. 2 (lcop2). Miesiące mają nasłabsze współczynniki korelacji z innymi atrybutami.
data(herring)
corr <- round(cor(herring[-1]),1)
ggcorrplot(corr, lab=TRUE, title="") +
ggtitle("Koorelacje między zmiennymi")
Na wykresie pokazującym jak zależy długość śledzia od temperatury
przy powierzchni wody można zaobserwować, że długość śledzia gwałtownie
spada przy temperaturze 14 \u00b0 C
ggplot(herring) +
geom_smooth(aes(x=sst, y=length)) +
ggtitle("Trend długości śledzia zależny od temperatury") +
xlab("Temperatura \u00b0C") +
ylab("Długość śledzia [cm]")
Sprawdzono jak zależą od siebie atrybuty dla największego współczynnika koorelacji:
ggplot(herring) +
geom_smooth(aes(x=lcop2, y=chel2)) +
ggtitle("Trend zagęszczenia widłonogów gat. 2 zależny od \nzagęszczenia Calanus helgolandicus gat. 2")
Wysoki współczynnik koorelacji (0,7) mają atrybuty: natężenie połowów w regionie (fbar) i łączne roczne natężenie w regionie (cumf). Natomiast wysoki ujemny współczynnik (-0,7) koorelacji mają łączna liczba ryb złowiona w ramach połowu (totaln) i łączne roczne natężenie w regionie (cumf).
ggplot(herring) +
geom_smooth(aes(x=cumf, y=fbar))+facet_wrap(vars(xmonth)) +
ggtitle("Trend natężenia połowów w regionie") +
xlab("Roczne natężenie połowów") +
ylab("Natężenie połowów")
ggplot(herring) +
geom_smooth(aes(x=cumf, y=totaln))+facet_wrap(vars(xmonth)) +
ggtitle("Trend łącznej liczby złowionych ryb i natężenia połowu w regionie") +
xlab("Natężenie połowów w regionie") +
ylab("Łączna liczba złowionych ryb")
Brak wpływu na długość śledzia mają roczny narybek (recr) oraz łączne roczne natężenie połowów w regionie (cumf).
ggplot(herring) +
geom_smooth(aes(x=length, y=recr))+facet_wrap(vars(xmonth)) +
ggtitle("Trend rocznego narybku i długości śledzia") +
xlab("Długość śledzia") +
ylab("Roczny narybek")
ggplot(herring) +
geom_smooth(aes(x=length, y=cumf))+facet_wrap(vars(xmonth)) +
ggtitle("Trend łącznego rocznego natężenia połowów w regionie i długości") +
xlab("Łączne roczne natężenie połowów w regionie") +
ylab("Łączna liczba złowionych ryb")
Dokonano podziału zbioru danych na uczące, walidujące i testowe. Zbiór uczący to 75% całego zbioru. Usunięto atrybut X - numer obserwacji. Przygotowano schemat uczenia na podstawie powwtarzającej się oceny krzyżowej (repeatedcv) z 2 podziałami i 5 powtórzeniami.
set.seed(23)
inTraining <-
createDataPartition(
y = herring$length,
p = .75,
list = FALSE)
herringWithoutX<-select(herring, -X)
training <- herringWithoutX[ inTraining,]
testing <- herringWithoutX[-inTraining,]
ctrl <- trainControl(
method = "repeatedcv",
number = 2,
repeats = 5)
Przygotowano uczenie przy pomocy regresji liniowej.
fit_lr <- train(length ~ .,
data = training,
method = "lm",
trControl = ctrl,
ntree = 10)
Dla regresji liniowej miara \(R^2\) wynosi 0.32, a \(RMSE\) 1.36. Najbardziej istotną zmienną jest fbar - natężenie połowóW w regionie. Pokazano podsumowanie dotyczące predykcji dla regresji liniowej.
fit_lr
## Linear Regression
##
## 39438 samples
## 14 predictor
##
## No pre-processing
## Resampling: Cross-Validated (2 fold, repeated 5 times)
## Summary of sample sizes: 19720, 19718, 19719, 19719, 19719, 19719, ...
## Resampling results:
##
## RMSE Rsquared MAE
## 1.363931 0.3198441 1.084964
##
## Tuning parameter 'intercept' was held constant at a value of TRUE
varImp(fit_lr)
## lm variable importance
##
## Overall
## fbar 100.00000
## cumf 89.52422
## sst 86.92289
## cfin1 24.20914
## lcop1 15.79213
## recr 15.68082
## totaln 12.80698
## nao 5.79945
## lcop2 5.61337
## chel1 4.69380
## cfin2 0.18658
## xmonth 0.14640
## sal 0.07872
## chel2 0.00000
ggplot(varImp(fit_lr))
predictions_lr <- predict(fit_lr,herringWithoutX)
print(summary(predictions_lr))
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 22.75 24.72 25.44 25.30 25.87 32.33
Dla porównania wykorzystano również algorytmu Random Forrest.
fit_rf <- train(length ~ .,
data = training,
method = "rf",
trControl = ctrl,
ntree = 10)
Dla Random Forrest miara \(R^2\) waha się między 0.498 - 0.515, a \(RMSE\) 1.148 - 1.170. Najbardziej istotną zmienną jest sst - temperatura przy powierzchni wody. Pokazano podsumowanie dotyczące predykcji dla algorytmy Random Forrest.
fit_rf
## Random Forest
##
## 39438 samples
## 14 predictor
##
## No pre-processing
## Resampling: Cross-Validated (2 fold, repeated 5 times)
## Summary of sample sizes: 19719, 19719, 19719, 19719, 19718, 19720, ...
## Resampling results across tuning parameters:
##
## mtry RMSE Rsquared MAE
## 2 1.170689 0.4989424 0.9256144
## 8 1.148605 0.5177060 0.9047644
## 14 1.151361 0.5158831 0.9055804
##
## RMSE was used to select the optimal model using the smallest value.
## The final value used for the model was mtry = 8.
varImp(fit_rf)
## rf variable importance
##
## Overall
## sst 100.0000
## recr 22.1442
## xmonth 14.1005
## fbar 9.9004
## lcop2 8.5712
## cfin2 8.1121
## lcop1 7.9122
## totaln 7.3580
## nao 4.7147
## chel2 4.1836
## chel1 2.9221
## cumf 1.2219
## sal 0.6018
## cfin1 0.0000
ggplot(varImp(fit_rf))
predictions_rf <- predict(fit_rf,herringWithoutX)
print(summary(predictions_rf))
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 20.82 24.60 25.34 25.31 26.23 28.41
Miara \(R^2\) jest większa dla regresji liniowej. Błąd średniokwadratowy jest mniejszy dla algorytmu Random Forrest. Najbardziej istotna zmienna dla Random Forrest sst - temperatura przy powierzchni wody w regresji liniowej występuje z wysoką wartością na 3 miejscu. Natomiast fbar natężenie połowów w regionie z niską wartością dla Random Forrest występuje na 4 miejscu.